home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Utilities / Text Utils / Alpha 5.81 ƒ / Tcl / UserCode / setBackupFolder.tcl < prev    next >
Encoding:
Text File  |  1994-07-07  |  3.8 KB  |  148 lines  |  [TEXT/ALFA]
  1. # FILE: setBackupFolder.tcl
  2. #
  3. # LAST UPDATE: 2/11/93 6:41:25 AM
  4.  
  5. # setBackupFolder = sets the backup folder based on location of file being
  6. # edited.  If folder named "$backName" is found relative to the file's location
  7. # or relative to any folder above, then that is used.  If no "$backName" folder
  8. # is found, then turn off backupFolder.  Thus the following hypothetical volume
  9. # has respective backup files:
  10. #
  11. # HD
  12. # :Backup:
  13. # ::Addresses.bak
  14. # :Lists:
  15. # ::Addresses
  16. # :Misc:
  17. # ::Letters:
  18. # :::Project RFQ
  19. # ::Backup:
  20. # :::Project RFQ.bak
  21. # ::Memos:
  22. # :::Backup:
  23. # ::::Organization.bak
  24. # :::Organization
  25. # Floppy:
  26. # :Readme
  27. # :Readme.bak
  28. #
  29. # To use, source this file.  It redefines activateHook & saveasHook,
  30. # keeping the old definitions as original-activateHook & original-saveHook.
  31. # A good place to source this is either from $HOME:AlphaBits.tcl (at the
  32. # end) or $HOME:UserBits.tcl
  33.  
  34. # HISTORY
  35. #                  
  36. # modified who rev reason
  37. # -------- --- --- ------ 
  38. # 02/11/93 DCB 1.1 Now executes after loading to establish base folder
  39. # 01/25/93 DCB 1.0 Original
  40. ################################################################################
  41.  
  42. # COPYRIGHT:
  43. #
  44. #    Copyright © 1992,1993 by David C. Black All rights reserved.
  45. #    Portions copyright © 1990, 1991, 1992 Pete Keleher. All Rights Reserved.
  46. #
  47. #    Redistribution and use in source and binary forms are permitted
  48. #    provided that the above copyright notice and this paragraph are
  49. #    duplicated in all such forms and that any documentation,
  50. #    advertising materials, and other materials related to such
  51. #    distribution and use acknowledge that the software was developed
  52. #    by David C. Black in conjunction with Pete Keleher.
  53. #
  54. #    THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
  55. #    IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
  56. #    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  57. #
  58. ################################################################################
  59.  
  60. # AUTHOR
  61. #
  62. #    David C. Black
  63. #    Internet: black@mpd.tandem.com (preferred)
  64. #    GEnie:    D.C.Black
  65. #    USnail:   6217 John Chisum Lane, Austin, TX 78749
  66. #
  67. ################################################################################
  68.  
  69. set backupDir ":BackUp"
  70. proc setBackupFolder {args} {
  71.     global backupDir
  72.     global backupFolder
  73.     global backupFolderName
  74.     if {[llength $args] > 0} {
  75.         set folder [lindex $args 0]
  76.     } else {
  77.         set wins [winNames -f]
  78.         if {[llength $wins] == 0} {
  79.             return
  80.         } else {
  81.             set folder [lindex $wins 0]
  82.         }
  83.     }
  84.     if {[regexp {^Untitled$} $folder]} {
  85.         return
  86.     }
  87.     regsub { <[0-9]+>$} $folder "" folder
  88.     if {[regexp {^[*].*[*]$} $folder]} {
  89.         # Ignore "*tcl shell*" and the like
  90.         return
  91.     }
  92.     while {[string first ":" $folder] >= 0} {
  93.         set folder  [file dirname $folder]
  94.         if ([file isdirectory "$folder$backupDir"]) {
  95.             set backupFolderName "$folder$backupDir"
  96.             set backupFolder 1
  97.             # message $backupFolderName
  98.             return
  99.         }
  100.     }
  101.     append folder "$backupDir"
  102.     if ([file isdirectory "$folder"]) {
  103.         set backupFolderName "$folder"
  104.         set backupFolder 1
  105.     } else {
  106.         set backupFolder 0
  107.     }
  108.     # message $backupFolderName
  109. }
  110. #endproc setBackupFolder
  111.  
  112. if {[info procs setBackupFolder-saveasHook] != "setBackupFolder-saveasHook"} {
  113.  
  114. rename saveasHook setBackupFolder-saveasHook
  115.  
  116. proc saveasHook {oldName newName} {
  117.     setBackupFolder $newName
  118.     set result [eval setBackupFolder-saveasHook {$oldName} {$newName}]
  119.     return $result
  120. }
  121. #endproc saveasHook
  122.  
  123. rename activateHook setBackupFolder-activateHook
  124.  
  125. proc activateHook name {
  126.     setBackupFolder $name
  127.     set result [eval setBackupFolder-activateHook {$name}]
  128.     return $result
  129. }
  130. #endproc activateHook
  131.  
  132. rename openHook setBackupFolder-openHook
  133.  
  134. proc openHook name {
  135.     setBackupFolder $name
  136.     set result [eval setBackupFolder-openHook {$name}]
  137.     return $result
  138. }
  139. #endproc openHook
  140.  
  141. }
  142. #endif
  143.  
  144. set wins [winNames -f]
  145. if {[llength $wins]} {
  146.     activateHook [lindex $wins 0]
  147. }
  148.